home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / win_utl2 / savers_.zip / SQUIRMY.PAS < prev   
Pascal/Delphi Source File  |  1996-05-29  |  4KB  |  129 lines
  1. program Squirmy_Dots;
  2.  
  3. (* The following 3 lines are not comments. *)
  4.  
  5. {$N-,E-,Q-,S-,R-,I-,O-,F-,P+,T-,X-,V-,B-,A+,G-,D-,L-,Y-}
  6. {$M 8192,0,65536}
  7. {$L Bgi256}  (* <──── Links the graphics object file (into the code segment). *)
  8.  
  9. (* Compiled in Borland Turbo Pascal 7.0 for DOS. Bgi256.Obj is a non-Borland
  10.    aftermarket add-on file. It is "registered", meaning the Bgi256.Obj file
  11.    itself isn't needed to run Squirmy Dots. *)
  12.  
  13. uses crt,drivers,graph;
  14.  
  15. var
  16. Gd, Gm, Error, X, Y, Timer : integer;
  17. Adjuster, Adjuster2 : char;
  18.  
  19. label Top, Start;
  20.  
  21. (* Gm := 0 is 320x200x256, 1 is 640x400x256, 2 is 640x480x256,
  22.          3 is 800x600x256, 4 is 1024x768x256, 5 is 1280x1024x256 *)
  23.  
  24. procedure Bgi256proc; external; (* The "public" name as declared by BinObj.exe *)
  25.  
  26. procedure InitBgi256;
  27. begin
  28. Gd := installuserdriver('Bgi256',nil);
  29. Error := registerbgidriver(@Bgi256proc);
  30. end;
  31.  
  32. procedure Exit_Program;
  33. begin
  34. closegraph;
  35. textcolor(7);
  36. textbackground(0);
  37. clrscr;
  38. textcolor(11);
  39. textbackground(1);
  40. gotoxy(1,4);
  41. write(' I''m glad you tried Squirmy Dots');
  42. textcolor(139);
  43. writeln('! ');
  44. writeln;
  45. donesyserror;   (* Turns off initsyserror for program exit. *)
  46. halt;
  47. end;
  48.  
  49. begin
  50. initsyserror;   (* Turns off ctrl-break, in drivers unit. *)
  51. Adjuster2 := 'A';
  52. textcolor(14);
  53. textbackground(5);
  54. randomize;
  55. Top:
  56. clrscr;
  57. gotoxy(1,3);
  58. writeln(' Welcome to "Squirmy Dots"! While it''s running, if you press N (for "new") you');
  59. writeln(' you blank the screen and start all over again. If you press any key besides B');
  60. writeln(' or N, you exit to DOS. If you have enough video ram as shown below, you will');
  61. writeln(' see up to 262,144 colors over a period of time. Even though this program shows');
  62. writeln(' only up to 256 colors at any one instant in time, the palette is "rotated" or');
  63. writeln(' "cycled", if you will, through 18 bits or 256k true color! (Over time though).');
  64. writeln(' Squirmy Dots is designed around a Christmas lights theme, in terms of a set of');
  65. writeln(' decoration lights. The video modes are in the menu below. This is version 6.0');
  66. writeln(' of the program. Also, you will see an occasional short flicker at the screen,');
  67. writeln(' this is intended. It''s in one of 262,144 shades also. This is all meant to be');
  68. writeln(' very relaxing like soft music. If you press the B key (for Back to this menu),');
  69. writeln(' you can return to this menu to choose another video mode, or exit the program.');
  70. writeln(' Choose a mode; 1 through 5 now to begin.....');
  71. writeln;
  72. writeln(' 1) Run Squirmy Dots at  320x200 (needs 256 k ram on the video card)');
  73. writeln(' 2) Run Squirmy Dots at  640x400 (needs 512 k ram on the video card)');
  74. writeln(' 3) Run Squirmy Dots at  640x480 (needs 512 k ram on the video card)');
  75. writeln(' 4) Run Squirmy Dots at  800x600 (needs 1 meg ram on the video card)');
  76. writeln(' 5) Run Squirmy Dots at 1024x768 (needs 1 meg ram on the video card)');
  77. writeln(' 6) Exit this program');
  78. writeln(' Remember, press B or N during the show if you like, any other key exits');
  79. gotoxy(46,15);
  80. Adjuster := readkey;
  81.  
  82. case Adjuster of
  83. '1' : begin  X:= 320; Y:=200; Timer:=144; Gm:=0;  end;
  84. '2' : begin  X:= 640; Y:=400; Timer:= 36; Gm:=1;  end;
  85. '3' : begin  X:= 640; Y:=480; Timer:= 30; Gm:=2;  end;
  86. '4' : begin  X:= 800; Y:=600; Timer:= 20; Gm:=3;  end;
  87. '5' : begin  X:=1024; Y:=768; Timer:= 12; Gm:=4;  end;
  88. '6' : Exit_Program;
  89. else goto Top;
  90. end;
  91.  
  92. if Adjuster2 = 'A' then InitBgi256;
  93.  
  94. initgraph(Gd,Gm,'');
  95. Error := graphresult;
  96. if Error <> 0 then
  97. begin
  98. closegraph;
  99. textcolor(7);
  100. textbackground(0);
  101. clrscr;
  102. textcolor(9);
  103. gotoxy(1,3);
  104. writeln(' Sorry, your display and/or video card is incompatible');
  105. writeln(' with this screen saver program. Oh, well; No harm done.');
  106. writeln;
  107. exit;
  108. end;
  109.  
  110. Start:
  111. repeat
  112. putpixel(random(X), random(Y), random(256));
  113. delay(random(Timer));
  114. delay(1);
  115. setrgbpalette(random(256), random(64), random(64), random(64));
  116. delay(random(Timer));
  117. delay(1);
  118. setrgbpalette(0,0,0,0);
  119. until keypressed;
  120.  
  121. Adjuster2 := readkey;
  122.  
  123. case Adjuster2 of
  124. 'n','N' : begin clearviewport; goto Start; end;
  125. 'b','B' : begin closegraph; goto Top; end;
  126. else Exit_Program;
  127. end;
  128.  
  129. end.